package Guile::Space::Value;
use warnings;
use strict;

use Moose;
use Scalar::Util qw(blessed);
use Carp;

#
#   The original value that is stored for access from the guile-space
#
has 'original_value',
    is          => 'rw',
    required    => 1,
    ;

#
#   A reference to the guile space, in case we might need it.
#
has 'guile_space',
    is          => 'rw',
    required    => 1,
    weak_ref    => 1,
    ;

#
#   These are the known types that can be executed. The values represent
#   the tests that tell if the according method (_execute_as_$type) is
#   to be used for execution of this callback.
#
my %execution_types = (
    'closure' => sub { ref shift eq 'CODE' },
    'object'  => sub { blessed shift },
    'hash'    => sub { ref shift eq 'HASH' },
    'array'   => sub { ref shift eq 'ARRAY' },
);

#
#   Executes a callback by testing it's type and delegating the args to
#   the proper method.
#
sub execute {
    my ( $self, $args ) = @_;
    my @args = @{ $args || [] };

    #   cleaning up arguments
    for (@args) {
        do { $_ = $_ + 0 ; next } if Guile::integer_p($_);
        do { $_ = "$_"   ; next } if Guile::string_p($_);
        do { $_ = "$_"   ; next } if Guile::real_p($_);
        do { $_ = "$_"   ; next } if Guile::symbol_p($_);
    }

    for my $type (keys %execution_types) {
        next unless $execution_types{ $type }->( $self->original_value );
        my $method = "_execute_as_$type";
        return $self->$method( @args );
    }

    die "Unknown Value Type.";
}

#
#   Execute a value that is merely a code reference.
#
sub _execute_as_closure {
    my ( $self, @args ) = @_;
    return $self->original_value->( @args );
}

#
#   Execute the value as an object. The first argument is regarded as the
#   name of the method to call.
#
sub _execute_as_object {
    my ( $self, $method, @args ) = @_;
    return $self->original_value->$method( @args );
}

sub _perl_to_guile {
    my ( $self, $value ) = @_;
    return $self->guile_space
        ->_prepare_single_value( undef, $value );
}

my %array_methods = (
    'get'       => sub { $_[1]->[ $_[2] ] },
    'set'       => sub { $_[1]->[ $_[2] ] = $_[3] ; $_[1] },
    'size'      => sub { scalar @{ $_[1] } },
    'last'      => sub { $#{ $_[1] } },
    'to-list'   => \&_array_to_list,
);
sub _execute_as_array {
    my ( $self, $method, @args ) = @_;
    my $store = $self->original_value;
    $method   = $array_methods{ $method }
        or croak "Unknown array method '$method'";
    return $method->( $self, $store, @args );
}
sub _array_to_list {
    my ( $self, $array ) = @_;
    return Guile::eval_str( 
        '(list ' . (
            join ' ',
            map  { $self->_perl_to_guile( $_ ) } 
            @$array
        ) . ')'
    );
}

my %hash_methods = (
    'get'       => sub { $_[1]->{ $_[2] } },
    'set'       => sub { $_[1]->{ $_[2] } = $_[3] ; $_[1] },
    'keys'      => sub { keys %{ $_[1] } },
    'values'    => sub { values %{ $_[1] } },
    'values-of' => sub { [ @{ $_[1] }{ @_[2 .. $#_] } ] },
    'to-hash'   => \&_hash_to_guilehash,
);
sub _execute_as_hash {
    my ( $self, $method, @args ) = @_;
    my $store = $self->original_value;
    $method   = $hash_methods{ $method }
        or croak "Unknown hash method '$method'";
    return $method->( $self, $store, @args );
}
sub _hash_to_guilehash {
    my ( $self, $hash ) = @_;
    my $count = scalar keys %$hash;
    return Guile::eval_str(
        "(let ((h (make-hash-table $count)))\n"
        . join( '', map { "(hashq-create-handle! h '$_ "
                . $self->_perl_to_guile( $hash->{ $_ } )
                . ")\n" } keys %$hash )
        . "h)"        
    );
}

1;
